00100	C ********** EARLY MUSIC NOTATION PACKAGE ************
00110	C TO CHANGE CONVENTIONAL NOTATION ENTERED WITH '14' OR '144' TO EARLY MUSIC
00120	C NOTATION, ADD 500 TO P4 OF ALL NOTES AND RESTS. (USE 'A' COMMAND.)
00130	C THE VARIOUS NOTE SHAPES ARE DETERMINED BY THE RHYTHMIC VALUE FOUND IN P9
00140	C (OR P7 WITH RESTS).  THE SAME SHAPES CAN BE MADE BY PUTTING VALUES IN P6 IF
00150	C P9=0.  THE FOLLOWING TABLE SHOWS NUMBERS FOR BOTH METHODS.  THE RHYTHMIC
00160	C VALUE (P9 OR P7) COMES BEFORE THE SHAPE NAME.  THE P6 VALUES FOLLOW EACH NAME.
00165	C THE STANDARD NOTE VALUES WOULD BE: DOUBLE WHOLE, WHOLE, 1/2, 1/4, 1/8, 1/16.
00170	C  8 = MAXIMA = 20;      4 = LONGA = 21;   2 = BREVIS = 22;
00180	C  1 = SEMIBREVE = 23;  .5 = MINIM = 24;  .25 = SEMIMINIM = 25;
00200	
00210	C  SET 'COLORATION' IN P8 IF NOT SET BY RHYTH.(P9)  -1=BLACK, 0=WHITE HERE.
00220	C MENSURATION SIGNS ARE CONSIDERED TO BE A FORM OF 'NOTE'.  THE VERTICAL
00230	C POSITION IS SET IN P4 WITH THE 'ZERO' LEVEL BEING IN THE SECOND SPACE FROM
00240	C THE BOTTOM OF THE STAFF. (POSITION OF NOTE 'A'.)
00245	C SET P9 TO 0 AND P6 AS FOLLOWS.
00250	C MENSURATION SIGNS: P6 =30=C; 31=C WITH DOT IN MIDDLE; 32=C WITH SLASH; 
00260	C  			33=O; 34=O WITH SLASH.
00265	
00270	C  LIGATURES ARE CREATED FROM COMBINATIONS OF MAXIMA, LONGA AND BREVIS SHAPES
00280	C  OR, FOR THE SLOPED SHAPES, BY SETTING P9=0 AND P6 EQUAL TO SOME NUMBER FROM
00290	C  11 TO 19.  FOR SLOPES IT IS THE SECOND DIGIT OF THE NUMBER THAT DETERMINES
00300	C  THE GOAL OF THE SLOPE.  IF THE NUMBER IS NEGATIVE THE SLOPE WILL BE DOWNWARD.
00310	C    P4=504  P6=11 WILL MAKE A SLOPE FROM F (TREBLE CLEF) UP TO G.
00320	C    IF P6=14 THE SLOPE WILL BE FROM F UP TO C.  P4=508  P6=-14 WILL GIVE A
00330	C    SLOPE DOWN FROM C TO F.
00340	
00360	C  FOR THE COMBINATION LIGATURES, FIRST SET P9 TO 0. NEXT THE RIGHT
00370	C HAND SQUARE WILL BE SET.  P6=22 GIVES A SIMPLE SQUARE WITH NO STEM.(BREVIS)
00380	C FOR A DESCENDING STEM ON THE RIGHT SIDE, P6=21.(LONGA)
00385	C FOR AN ASCENDING STEM ON THE RIGHT SIDE, P6=29.
00400	C FOR A STEM ON THE LEFT SIDE OF THE SQUARE SET P7 TO A NEGATIVE NUMBER.
00410	C THE ABSOLUTE VALUE OF THIS NUMBER WILL DETERMINE THE LENGTH OF THE STEM.
00420	C THE DIRECTION OF THIS LEFT STEM IS SET IN P5. UP, P5=10; DOWN, P5=20.
00430	
00440	C THE LEFT HAND SQUARE IS IS BEST ENTERED BY MAKING A COPY OF THE RIGHT ONE.
00450	C WITH THE COPY, WHEN P5 IS SET TO -1 THE SQUARE PIVOTS ON ITS LEFT SIDE.
00460	C THIS NEW NOTE MAY BE MOVED UP OR DOWN TO THE PROPER POSITION.  AS A
00470	C RESULT OF THIS PIVOTING A STEM THAT WAS ORIGINALLY ON THE RIGHT SIDE NOW
00480	C APPEARS ON THE LEFT SIDE.(STEM UP, P6=21; DOWN, P6=29)  NO STEM CAN BE
00490	C PUT ON THE RIGHT SIDE OF A REVERSED NOTE.  ANY STEM NEEDED IN THE CENTRAL
00500	C POSITION, BETWEEN THE TWO SQUARES, CAN BE ADDED TO THE RIGHT HAD NOTE BY
00510	C PUTTING THE PROPER VALUES IN P7 (NEGATIVE) AND P5 (10=↑, 20=↓).  BY
00520	C CHANGING THE VALUES OF P7 THIS CENTRAL STEM MAY BE USED TO CONNECT THE
00530	C TWO NOTES TOGETHER AS WELL AS TO EXTEND BEYOND THE LEFT HAND NOTE.
00540	C BY USING THIS PIVOTING METHOD BOTH HALVES OF A TWO NOTE LIGATURE WILL
00550	C WILL HAVE THE SAME HORIZANTAL POSITION IN P3, WHICH WILL INDICATE THE
00560	C CENTER OF THE LIGATURE.
00570	
00810		SUBROUTINE EXTRA 
00820		IMPLICIT INTEGER(A-Q,S-Z)
00830		REAL POS
00840		COMMON /STF/RSTFAC(-3/4),RSTJ2
00850		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
00860		COMMON/PLTR/PLT,RHT,DIS /POSI/STFF(-3/4),JJ2,POS
00870		COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RB,RZ,RJY,
00900		1 QQ,RJW,ZZ,JX,RG,KL,RJAC,K,L,RQ,RXO,J5X,RNO,JJJ,
01000		1 PUNCT,RDIS,RJ
01100		EQUIVALENCE (R4,RJQ(2)),(J5,JQ(3)),(R6,RJQ(4)),(NJR,RJQ(8)),
01200		1 (J6,JQ(4)),(R8,RJQ(6)),(R7,RJQ(5)),(R9,RJQ(7)),(J9,JQ(7))
01300		1,(J4,JQ(2)),(R3,RJQ(1)),(J10,JQ(8)),(R11,RJQ(9)),(J8,JQ(6))
01400		1,(J7,JQ(5)),(RX3,RJQ(20)),(R5,RJQ(3)),(RH,RJQ(19)),(RXX,RJQ(18))
01500		DATA RBIG/1.5/
01600	
01700		IF(JA.EQ.2)R9=R7
01800		KL=IABS(J6)
01900		IF(KL.GT.5)GO TO 10
02000		IF(R9.NE.0)GO TO 2
02100	10	IF(JA.EQ.1)J5=J6
02200		IF(KL.GE.30)GO TO 30
02300	C  JUMP FOR MENSURATION SIGNS.
02400	C  PUT NUM. IN P6 IF P9 NOT USED. 20=MAXIMA, 21=LONGA, 22=BREVIS, ETC.
02500		IF(R8.GE.0)R8=-2
02600	C  MAKES IT WHITE UNLESS -1 IS IN R8
02700		GO TO 3
02710	2	RH=.75
02720		DO 21 K=1,5
02730		IF(R9.NE.RH)GO TO 21
02740		R9=R9*2
02745		R9=R9/3.
02750		GO TO 22
02760	21	RH=RH*2.
02800	22	RA=AMOD(R9,.25)
02900	C  RA=0=WHITE,  ≠0='COLORATION'
03000		IF(RA.NE.0)R9=R9*1.5
03100	C  TO GET THE RIGHT SHAPE
03200		J5=19.5+ALOG(16./R9)/.693147181
03300	C  I.E. /ALOG(2.)  FINDS SEQ. NUM IN DRAW FILE 'EARLY'. 20=MAXIMA, ETC.
03400		R8=-1
03500	C  FILL IT ALWAYS (BLACK NOTE)
03600		IF(RA.EQ.0)R8=-2
03700	C  ALWAYS WHITE
03800	3	IF(JA.EQ.2)GO TO 20
03900		RH=R5
04000		JA=3 
04100		K=J4
04200		RXX=POS-18.*RSTJ2
04300		IF(J5.LT.20)GO TO 6
04400	C GO MAKE 'LIGATURES' P6=11=1 UP, =-11=1 DOWN, 12=2 UP, ETC.
04500		R6=RBIG
04600		NJR='CLEF2'
04700	C  ↑↑↑ EQUIV. TO R10
04800		R7=RBIG
04900		IF(R5)R6=-R6
05000	C  IF P5 IS NEG THEN ITEM MOVES TO LEFT EXACTLY ITS SPACE.
05100	5	J9=0
05200	C  NO ROTATION PLEASE.
05300	CC	IF(R5.LT.20.)GO TO 7
05400	C  TURN OVER THE NOTE
05500	CC	R4=R4-5.8
05600	CC	R7=-R6
05650	CC7	RSS=RG
05700	7	CALL CLEFS
05800		IF(J7.GE.0)GO TO 1
05900	C IF P7 IS NEG THERE WILL BE A STEM ON LFT SIDE =ABS(R7), P5 HAS UP-DN.
06000		RG=R4
06100		R5=-J7*RST7
06200		GO TO 14
06300	6	RG=R4
06400	C THIS WILL BE FOR LIGATURE STEMS (P5=10=UP, =20=DOWN)
06500		IF(KL.GT.10)GO TO 11
06600		R6=-R6*10.
06700		GO TO 12
06800	11	R6=KL-10
06900		IF(J6)R6=-R6
07000	12	RA=R3
07010		R7X=-.2
07020		IF(R6)R7X=-R7X
07030		R4=R4+R7X
07040		R6=R6-R7X*2.
07050	C  ABOVE TO ADJUST END POINTS OF TILTS.
07100		IF(J8)GO TO 9
07200		R4=R4-.45
07300		J5=50
07400	C  P8<0=BLACK LIG.   ≥0=WHITE LIG.
07500		J10=1
07600		R9=1.7
07700		R8=3.64
07800		R11=R6
07900		R3=R3+13.85*RSTJ2
08000		GO TO 8
08100	9	R4=R4-.9
08200		R5=R4+R6/RSTJ2
08300	CC	R9=200
08400		J7=1
08500		R8=4.6
08600		R6=RX3+R8
08700		J10=14.*RSTJ2
08800	C  MAKES SLOPED DASH, 14XTHICK
08850	8	R7X=R7
08900		CALL ITMSUB
09000		IF(RH.EQ.0)GO TO 13
09050		R5=ABS(R7X)
09075		IF(R5.EQ.0)R5=5
09100		R5=R5*RST7
09200	14	RG=RG*RST7+RXX
09300		IF(RH.GE.20)R5=-R5
09400	C NOW STEM IS DOWN. (-R5)
09500		CALL LINX(R3,RG,R3,RG+R5)
09600	13	R4=RG
09700		J5=20
09800		R3=RA
09900	
10000	1	IF(K.LT.502)GO TO 4
10100		IF(K.LT.513)RETURN
10200	C  WILL NOW DO 1 LEDG. LINE ABOVE OR BELOW.
10300	4	R4=RST7
10400		IF(K.GT.502)R4=13.*RST7
10500		R4=R4+RXX
10600		R5=20.
10700		IF(J5.EQ.20)R5=34.
10800		CALL LINX(R3-RST7,R4,R3+R5*RSTJ2,R4)
10900	
11000		RETURN
11100	
11200	20	IF(R9.NE.0)J5=R5+23.
11300		RG=POS
11400	C SAVE IT FOR SEMIMINIM REST HORIZANTAL
11500	C  RESTS ARE SET BY RHYTHM(R9,7) OR IN J5 (20-25)
11600		R5=(J5-20)*2+3
11700		RA=R4
11800		IF(R5.GT.8.)R5=8.
11900		R5=R4+R5
12000	C  RESTS (500+ IN P4) CAN BE MOVED UP OR DOWN
12100		R4=9
12200		IF(J5.GT.23)R4=7.
12300		R4=R4+RA
12400		J10=2
12500		J7=0
12600		R6=RX3
12700	C ALL THIS MAKES VERT. LINE.
12800		CALL ITMSUB
12900		IF(J5.LT.25)RETURN
13000	C NEXT IS FOR SEMIMINIM REST (1/16)
13100		R6=RX3+1.3
13200		R4=8+RA
13300		R5=R4
13400		POS=RG
13500		CALL ITMSUB
13600	 	RETURN
13700	
13800	C  MENSURATION SIGNS. USES P6 AS A NOTE. =30=C; 31=C.; 32=C/; 33=O; 34=O/
13900	30	JA=12
13910		R4=R4+6
13920		CALL CENTX
13930	C  P4=500 PUTS IT AT POS 6.
14000		R5=1
14100		J8=1
14200		IF(J5.GT.32)GO TO 31
14300	C  NEXT ARE C'S
14400		J6=125
14500		J7=45
14600		GO TO 32
14700	31	J6=0
14800		J7=0
14900	32	CALL SLUR
15000		IF(J5.NE.31)GO TO 33
15100	C  NEXT IS C.
15110		J5=0
15200		J6=0
15250		J7=0
15300		R5=.1
15400		GO TO 31
15500	33	IF(J5.LT.32)RETURN
15600		IF(J5.EQ.33)RETURN
15800		R5=R4+1
15810		R4=R4-1
15900		R3=R3-11.*RSTJ2
16000		J7=0
16100		R6=RX3+2*RSTJ2
16200		CALL ITMSUB
16300		END